home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d923.lha / OberonPrefs / Rexx / OCmd.ced next >
Text File  |  1993-10-07  |  7KB  |  241 lines
  1. /* ------------------------------------------------------------------------
  2.   :Program.       OCmd.ced
  3.   :Contents.      Start Oberon tools with Ced & OberonPrefs
  4.   :Author.        Kai Bolay [kai] & Franz Schwarz
  5.   :Copyright.     FD
  6.   :History.       v1.0 [fSchwarz]
  7.   :Version.       $VER: Options 1.0 (25.6.93)
  8.   :Language.      ARexx
  9.   :Translator.    RexxMast
  10.   :Remarks.       fSchwarz says: Due to the billions of changes and new
  11.   :Remarks.       concepts introduced into this script since Kai's v1.2
  12.   :Remarks.       release of Cmd.ced, I decided to drop the history and
  13.   :Remarks.       reset version count to 1.0.
  14. ------------------------------------------------------------------------ */
  15.  
  16. options results
  17.  
  18.  
  19. errcmd = "rexx:OErr.ced"
  20. window = "CON:0/100//200/ExeOberon/SCREENCygnusEdScreen1"
  21. minstack=20000
  22. enddelay = 2 
  23. endwait = 'TRUE'   /* 'TRUE', 'OK', 'FAIL', 'FALSE' */
  24.  
  25. address 'rexx_ced'
  26.  
  27. libname='oberonsupport.library'
  28. if ~show('l',libname) then if ~addlib(libname,0,-30) then do
  29.   'Okay1 No 'libname'!'
  30.   exit
  31. end  
  32. libname='rexxsupport.library'
  33. if ~show('l',libname) then if ~addlib(libname,0,-30) then do
  34.   'Okay1 No 'libname'!'
  35.   exit
  36. end  
  37.  
  38. unique=pragma('ID') || time('S')
  39.  
  40. portnam='ocmd'unique
  41.  
  42. status 21 /* filename */
  43. clipname = 'CMDActive' || result;
  44. if getclip(clipname)~='' then do
  45.   Okay1 "Datei wird bereits von Script bearbeitet!"
  46.   exit 20;
  47. end
  48.  
  49.  
  50. if ~setclip(clipname,'TRUE') then do
  51.   Okay1 "Kann Datei nicht als 'Busy' markieren!"
  52.   call cleanup 20;
  53. end
  54.  
  55. signal on halt
  56. signal on error
  57. signal on syntax
  58. signal on break_c
  59. signal on break_d
  60. signal on break_e
  61. signal on break_f
  62.  
  63. arg tool
  64.  
  65. select
  66.   when tool = "COMPILE" then  scriptname = "T:Compiler-Start"unique
  67.   when tool = "MAKE" then scriptname = "T:Make-Start"unique
  68.   when tool = "LINK" then scriptname = "T:Linker-Start"unique
  69.   otherwise do
  70.     Okay1 "Fehler: Falscher Aufruf!"
  71.     call cleanup 20
  72.   end
  73. end
  74.  
  75. status 21 /* Nur Filnamen (ohne Pfad) holen */
  76. filename = result
  77. optsname = 'OberonOpts'compress(filename)
  78. opts = GetClip(optsname)
  79.  
  80. if filename = "" then do
  81.   Okay1 "Fehler: Kein Filename"
  82.   call cleanup 20
  83. end
  84.  
  85. if upper(right(filename,4)) ~= ".MOD" then do
  86.   Okay1 "Fehler: Filename endet nicht auf '.mod'"
  87.   call cleanup 20
  88. end
  89.  
  90. filename = left(filename,length(filename)-4)
  91.  
  92. status 20 /* Nur Pfad (ohne Filenamen) holen */
  93. path = result
  94.  
  95. if upper(right(path,4)) == "/TXT" | upper(right(path,4)) == ':TXT' then
  96.   path = left(path,length(path)-4)
  97.  
  98. status 18 /* changes */
  99. if result~=0 then select
  100.   when tool = "COMPILE" then save
  101.   when tool = "MAKE" then save
  102.   otherwise nop
  103. end
  104.  
  105. 'status 19' /* Filename mit Pfad */
  106. filepath = result
  107. status 21 /* Nur Filnamen (ohne Pfad) holen */
  108. optsname = 'OberonOpts'compress(result)
  109. uniqueoptsname = 'OberonOpts'unique
  110. opts1 = GetClip(optsname); opts = opts1
  111. if opts = '' then do
  112.   address command 'rxset 'uniqueoptsname' `OberonPrefs nogui omakeout settings 965 '||,
  113.     'from "'filepath'"`'
  114.   opts = GetClip(uniqueoptsname)
  115.   call setclip uniqueoptsname
  116. end
  117. if opts = '' then opts = 'c- l-'
  118. parse var opts 'c' oberonopts ' l' olinkopts
  119.  
  120.  
  121. if ~open(script,scriptname,'W') then do
  122.   Okay1 "Fehler: Kann Script nicht öffnen"
  123.   call cleanup 20
  124. end
  125.  
  126.  
  127. call writeln(script,".bra {")
  128. call writeln(script,".ket }")
  129. call writeln(script,"Failat 2147483647")
  130. call writeln script,'stack `rx "say max('minstack",pragma('stack',10000))"||'"`' /* ensure minstack, but don't bother if more */
  131. call writeln script,'cd "'path'"'
  132. call writeln script,'delete >nil: OBP'unique
  133. call writeln script,'rename >nil: Oberon.Prefs to OBP'unique
  134. call writeln script,'echo >Oberon.Prefs ""'
  135. call writeln script,'delete >nil: OLP'unique
  136. call writeln script,'rename >nil: OLink.Prefs to OLP'unique
  137. call writeln script,'echo >OLink.Prefs ""'
  138.  
  139. select
  140.   when tool = "COMPILE" then do
  141.     cmd = "Oberon" AddOpts("OberonOpts")
  142.   end
  143.   when tool = "MAKE" then do
  144.     cmd = "OMake" AddOpts("OMakeOpts") 
  145.   end
  146.   when tool = "LINK" then do
  147.     cmd = "OLink" AddOpts("OLinkOpts")
  148.   end
  149. end
  150. cmd = cmd || ' "' || filename || '"'
  151.  
  152. call writeln(script,cmd)
  153. call writeln(script,"set ocmdrc"unique" $rc")
  154. call writeln script,'delete >nil: Oberon.Prefs'
  155. call writeln script,'rename >nil: to Oberon.Prefs OBP'unique
  156. call writeln script,'delete >nil: OLink.Prefs'
  157. call writeln script,'rename >nil: to OLink.Prefs OLP'unique
  158.  
  159. select
  160.   when endwait='TRUE' then call  writeln(script,"if 0 eq 0")
  161.   when endwait='OK' then call    writeln(script,"if $ocmdrc"unique" eq 0")
  162.   when endwait='FAIL' then call  writeln(script,"if not $ocmdrc"unique" eq 0")
  163.   when endwait='FALSE' then call writeln(script,"if 1 eq 0")
  164. end
  165. call writeln(script,"  if $ocmdrc"unique" eq 0")
  166. call writeln(script,"    ask ""*nKeine Fehler - <RETURN>"" ")
  167. call writeln(script,"  else")
  168. call writeln(script,"    ask ""*nAufruf fehlgeschlagen! - <RETURN>"" ")
  169. call writeln(script,"  endif")
  170. call writeln(script,"else")
  171. call writeln(script,"  wait "enddelay)
  172. call writeln(script,"endif")
  173. call writeln(script,"rx ""options results; address '"portnam"' 'Finished $ocmdrc"unique"'"" ")
  174. call writeln(script,"endcli")
  175.  
  176. if ~close(script) then do
  177.   Okay1 "Fehler: Kann Script nicht schließen"
  178.   call cleanup 20
  179. end
  180. if c2d(OpenPort(portnam))=0 then do
  181.   okay1 'Fehler: Kann Msgport nicht öffnen'
  182.   address command 'delete >nil: 'scriptname
  183.   call cleanup 20
  184. end
  185. select
  186.   when tool = "COMPILE" then address REXX ''errcmd' CLEAR'
  187.   when tool = "MAKE"    then address REXX ''errcmd' CLEAR'
  188.   otherwise nop
  189. end
  190. address command 'NewShell 'window' from 'scriptname
  191. do while ~waitpkt(portnam); nop; end
  192. pkt=getpkt(portnam)
  193. if c2d(pkt)~=0 then do
  194.   ret=getarg(pkt)
  195.   parse upper var ret 'FINISHED' ret dummy
  196.   call reply pkt,0
  197.   if ret ~= 0 then do
  198.     if tool = "COMPILE" then do
  199.       address REXX ''errcmd' FIRST'
  200.     end; else do
  201.       if (endwait~='TRUE') & (endwait~='FAIL') then Okay1 "Fehler: Aufruf fehlgeschlagen!"
  202.     end
  203.   end
  204. end
  205.  
  206. address command 'delete >nil: 'scriptname
  207. call cleanup
  208.  
  209. AddOpts: procedure expose OberonOpts OLinkOpts unique uniqueoptsname
  210.   arg name 'OPTS'
  211.   outname = name || 'OUT'
  212.   address command 'rxset 'uniqueoptsname' `OberonPrefs from default nogui 'outname,
  213.     ' oberonopts 'oberonopts' olinkopts 'olinkopts'`'
  214.   ret = getclip(uniqueoptsname)
  215.   call setclip uniqueoptsname
  216.   return ret
  217.  
  218. cleanup:
  219.   call SetClip clipname
  220.   exit arg(1)
  221.  
  222.  
  223. error:
  224. syntax:
  225.   call SetClip clipname
  226.   'okay1 OCmd.ced-Abbruch: Programmfehler'
  227.   exit
  228.  
  229. halt:
  230.   call SetClip clipname
  231.   exit
  232.  
  233. break_c:
  234. break_d:
  235. break_e:
  236. break_f:
  237.   call SetClip clipname
  238.   'okay1 OCmd.ced-Abbruch: Benutzerunterbrechung'
  239.   exit
  240.  
  241.